home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / dataval.exe / VALID2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-02-22  |  4.3 KB  |  173 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Demo program from the Turbo Vision Guide     }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9. {$X+}
  10.  
  11. program TVGUID16;
  12.  
  13. uses Objects, Drivers, Views, Menus, Dialogs, App;
  14.  
  15. type
  16.   DialogData = record
  17.     InputLineData: string[128];
  18.   end;
  19.  
  20.   TMyApp = object(TApplication)
  21.     constructor Init;
  22.     procedure InitStatusLine; virtual;
  23.     procedure NewDialog;
  24.   end;
  25.  
  26.   PDemoDialog = ^TDemoDialog;
  27.   TDemoDialog = object(TDialog)
  28.     function Valid(Command: Word): Boolean; virtual;
  29.   end;
  30.  
  31.   PValidInputLine = ^TValidInputLine;
  32.   TValidInputLine = object(TInputLine)
  33.     IsValid: Boolean;
  34.     constructor Init(var Bounds: TRect; AMaxLen: Integer);
  35.     function GetPalette: PPalette; virtual;
  36.     procedure HandleEvent(var Event: TEvent); virtual;
  37.     function Valid(Command: word): Boolean; virtual;
  38.   end;
  39.  
  40.  
  41. function TDemoDialog.Valid(Command: Word): Boolean;
  42. var Q: PView;
  43.  
  44.   function IsInvalid(P: PView): Boolean; far;
  45.   begin
  46.     IsInvalid := not P^.Valid(Command);
  47.   end;
  48.  
  49. begin
  50.   Q := FirstThat(@IsInvalid);
  51.   if Q <> nil then
  52.     if Q <> Current then
  53.       Q^.Select           { The input line will not be redrawn in    }
  54.     else                  { the passive error color if it is already }
  55.       begin               { selected.  By moving the Current pointer }
  56.       Lock;               { forward, and then back again, we can get }
  57.       SelectNext(True);   { the passive error color. The Lock and    }
  58.       SelectNext(False);  { Unlock are to prevent flicker.           }
  59.       Unlock;
  60.       end;
  61.   Valid := (Q = nil);
  62. end;
  63.  
  64.  
  65. constructor TValidInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
  66. begin
  67.   TInputLine.Init(Bounds, AMaxLen);
  68.   IsValid := Valid(cmOk);
  69. end;
  70.  
  71.  
  72.  
  73. function TValidInputLine.GetPalette: PPalette;
  74. const AltPalette: String[Length(CInputLine)] = CInputLine;
  75. begin
  76.      { By assigning a palette index number that is out of the range of
  77.        our owner's palette, we automatically get flashing white on red
  78.        for this color entry.  This should instead be mapped to an
  79.        actual palette entry in the owner... }
  80.   AltPalette[1] := #255;
  81.   if IsValid then
  82.     GetPalette := TInputLine.GetPalette
  83.   else
  84.     GetPalette := @AltPalette;
  85. end;
  86.  
  87.  
  88. procedure TValidInputLine.HandleEvent(var Event: TEvent);
  89. begin
  90.   if Event.What <> evnothing then
  91.     IsValid := True;
  92.   TInputLine.HandleEvent(Event);
  93. end;
  94.  
  95.  
  96. function TValidInputLine.Valid(Command: Word): Boolean;
  97. begin
  98.   if Command <> cmCancel then
  99.   begin
  100.     IsValid := (Data^ = 'Hello');
  101.     Valid := IsValid;
  102.     write(#7);      { "hear" where & when Valid is called }
  103.   end;
  104. end;
  105.  
  106.  
  107. var
  108.   DemoDialogData: DialogData;
  109.  
  110.  
  111. { TMyApp }
  112. constructor TMyApp.Init;
  113. begin
  114.   TApplication.Init;
  115.   NewDialog;
  116. end;
  117.  
  118.  
  119. procedure TMyApp.InitStatusLine;
  120. var R: TRect;
  121. begin
  122.   GetExtent(R);
  123.   R.A.Y := R.B.Y - 1;
  124.   StatusLine := New(PStatusLine, Init(R,
  125.     NewStatusDef(0, $FFFF,
  126.       NewStatusKey('', kbF10, cmMenu,
  127.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  128.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  129.       nil))),
  130.     nil)
  131.   ));
  132. end;
  133.  
  134. procedure TMyApp.NewDialog;
  135. var
  136.   Bruce: PView;
  137.   Dialog: PDemoDialog;
  138.   R: TRect;
  139.   C: Word;
  140. begin
  141.   R.Assign(20, 6, 60, 19);
  142.   Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  143.   with Dialog^ do
  144.   begin
  145.     R.Assign(3, 8, 37, 9);
  146.     Bruce := New(PValidInputLine, Init(R, 128));
  147.     Insert(Bruce);
  148.     R.Assign(2, 7, 37, 8);
  149.     Insert(New(PLabel, Init(R, 'Type: Hello, then Tab around.', Bruce)));
  150.     R.Assign(15, 10, 25, 12);
  151.     Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  152.     R.Assign(28, 10, 38, 12);
  153.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  154.   end;
  155.   Dialog^.SetData(DemoDialogData);
  156.   C := DeskTop^.ExecView(Dialog);
  157.   if C <> cmCancel then Dialog^.GetData(DemoDialogData);
  158.   Dispose(Dialog, Done);
  159. end;
  160.  
  161. var
  162.   MyApp: TMyApp;
  163.  
  164. begin
  165.   with DemoDialogData do
  166.   begin
  167.     InputLineData := 'Phone home.';
  168.   end;
  169.   MyApp.Init;
  170.   MyApp.Run;
  171.   MyApp.Done;
  172. end.
  173.